home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.17 / pcq-programme / game / game.mod < prev    next >
Text File  |  1995-04-22  |  39KB  |  1,035 lines
  1.  
  2.  
  3. External;
  4.  
  5. {   Die hier folgenden Routinen sind alle für die Benutzung
  6.     ind den Spielen gedacht.
  7.     Nähere Informationen: siehe Dokumentation
  8. }
  9.  
  10.  
  11. { --------------------------------------------------------------------- }
  12. { ---------    GraphCollision  ---------------------------------------- }
  13. { --------------------------------------------------------------------- }
  14.  
  15. {$I "include:Exec/libraries.i"  }
  16. {$I "include:exec/interrupts.i"  }  { für Permit/Forbid und VB-Server }
  17. {$I "Include:Exec/Memory.i"}        { * für den VB-Server * }
  18. {$I "Include:Exec/nodes.i"}         { * Für den VB-Server * }
  19.  
  20. {$I "include:intuition/intuition.i"}
  21.  
  22. {$I "include:graphics/Pens.i"      }
  23. {$I "include:graphics/Text.i"      }
  24. {$I "include:graphics/Graphics.i"  }
  25. {$I "include:graphics/rastport.i"  } { für den Rastport }
  26. {$I "include:graphics/blitter.i"  }  { für die Blitter-Funktionen }
  27.  
  28. {$I "Include:Hardware/intbits.i"} { Für den VBServer. }
  29. {$I "Include:Libraries/DOS.i"}      { * Für die Sample-Routinen. * }
  30. {$I "Include:Utils/StringLib.i"}    { * Für die Sample-Routinen. * }
  31.  
  32.  
  33. { - Die verwendeten Typen, Constanten und Variablen. ------------------ }
  34.  
  35.  
  36. TYPE
  37.         ObjektDef = record  { die Definition meiner Spielobjekte }
  38.             Ox      :   short;  { x-Position linke obere Ecke }
  39.             Oy      :   short;  { y-Position linke obere Ecke }
  40.             Sizex   :   short;  { x-size }
  41.             Sizey   :   short;  { y-size }
  42.             Speedx  :   short;  { x-Geschwindigkeit }
  43.             Speedy  :   short;  { y-Geschwindigkeit }
  44.             Phase1  :   short;  { Bewegungsphasenzähler1 }
  45.             Phase2  :   short;  { Bewegungsphasenzähler2 }
  46.             typ     :   short;  { Objekttyp }
  47.         end;
  48.  
  49. CONST
  50.         Objektsize : integer = sizeof(ObjektDef); { Größe eines Objektes }
  51.  
  52. VAR
  53.         Objekt     : array[0..255] of ObjektDef;  { Max. Anzahl der Objekte }
  54.         Picture    : array[1..100] of Imageptr;  { Max. 100 Bilder. Daten
  55.                                                   nur als Pointer ( um
  56.                                                   schneller Bilder
  57.                                                   zuzuordnen) }
  58.  
  59.         blitctrl        : short;    { Globale Variable für Blitterergebnis }
  60.         BlittiSpeicher  : Address;  { Wird benötigt, weil überschneidungen
  61.                                       bei der Bearbeitung auftreten !!! }
  62.         MyBitMap        : Address;  { Adresse der BitMap }
  63.         MyRPort         : RastPortPtr;
  64. { --------------------------------------------------------------------- }
  65. { - Die verwendeten Typen, Variablen und Konstanten für den VB-Server - }
  66. { --------------------------------------------------------------------- }
  67.  
  68.         vbint : InterruptPtr;
  69.         VBcounter : integer;
  70.  
  71. { --------------------------------------------------------------------- }
  72. { - Die verwendeten Typen, Konstanten und Variablen für die Playsample  }
  73. { - Routinen. --------------------------------------------------------- }
  74. { --------------------------------------------------------------------- }
  75. type
  76.     Voice8Header = record
  77.         oneShotHiSamples,
  78.         repeatHiSamples,
  79.         samplesPreHiCycle : Integer;
  80.         samplesPerSec : Short;
  81.         ctOctave        : Byte;
  82.         sCompression    : Byte;
  83.         volume : Integer;
  84.     end;
  85.  
  86.     Sampletabdef = record
  87.         dbuf    : Address;      { * Enthält die Adresse des Samplebuffers. * }
  88.         dlen    : integer;      { * Länge des Samples. * }
  89.         dhz     : short;        { * Tonhöhe. * }
  90.     end;
  91.  
  92.     FibTable = Array [0..15] of Byte;
  93.  
  94. const
  95.     FP          : FileHandle = Nil;
  96.     codeToDelta : FibTable = (-34, -21, -13, -8, -5, -3, -2, -1, 0,
  97.                                 1, 2, 3, 5, 8, 13, 21);
  98.     Sampletab   : array[1..10] of Sampletabdef = (
  99.                   ( Nil, 0, 0),
  100.                   ( Nil, 0, 0),
  101.                   ( Nil, 0, 0),
  102.                   ( Nil, 0, 0),
  103.                   ( Nil, 0, 0),
  104.                   ( Nil, 0, 0),
  105.                   ( Nil, 0, 0),
  106.                   ( Nil, 0, 0),
  107.                   ( Nil, 0, 0),
  108.                   ( Nil, 0, 0)                    );
  109.  
  110.     Sampletabsize : integer = sizeof(Sampletabdef);
  111.     Channel : byte = 0;     { * Enthält die Nummer des neu zu belegenden
  112.                                 Kanals. * }
  113. var
  114.     VHeader     : Voice8Header;
  115.  
  116. { --------------------------------------------------------------------- }
  117.  
  118. Procedure Copyright();
  119. VAR
  120.     Copyright, Revnummer : String;
  121. begin
  122.     CopyRight := "7. Juni 1993 , Jörg Wach ";
  123.     RevNummer := "Version V1.20";
  124. end;
  125.  
  126. { --------------------------------------------------------------------- }
  127.  
  128. Procedure GraphCollision( x1, y1, xsize, ysize : short);
  129. { Testet einen BitMapBereich auf vorhandene Punkte. xsize und ysize
  130.   bestimmen das Ausmaß des zu testenden Bereiches. }
  131. var
  132.     dummy : integer;    { Rückgabewert von BltBitMap. Wird nicht benötigt }
  133. begin
  134.     ysize := ysize + 1;
  135.     Forbid();   { Taskswitching aus, damit ist der Blitter mein }
  136.     WaitBlit(); { Auf den Blitter warten, falls dieser noch arbeitet }
  137.     dummy := BltBitMap(MyBitMap,x1,y1,MyBitMap,x1,y1,xsize,ysize,$c0,1,BlittiSpeicher);
  138.     WaitBlit(); { Auf den Blitter warten, falls dieser noch arbeitet }
  139. {$A
  140.     btst.b  #5,$dff002          ; Diese Bit wollen wir testen
  141.     beq.s   Collision1          ; Kollision
  142.     move.w  #0,_blitctrl        ; keine Kollision
  143.     bra.s   Collision2          ; 2. BitPlane abfragen
  144. Collision1:
  145.     move.w  #1,_blitctrl        ; Kollision. _blitctrl setzen
  146. Collision2:
  147. }
  148.     if blitctrl = 0 then begin  { keine Kollision in der 1. Plane }
  149.         dummy := BltBitMap(MyBitMap,x1,y1,MyBitMap,x1,y1,xsize,ysize,$c0,2,BlittiSpeicher);
  150.         WaitBlit(); { Auf den Blitter warten, falls dieser noch arbeitet }
  151. {$A
  152.     btst.b  #5,$dff002          ; Diese Bit wollen wir testen
  153.     beq.s   Collision3          ; Kollision
  154.     move.w  #0,_blitctrl        ; keine Kollision
  155.     bra.s   Collision4          ; 3. BitPlane abfragen
  156. Collision3:
  157.     move.w  #1,_blitctrl        ; Kollision
  158. Collision4:
  159. }
  160.         if blitctrl = 0 then begin { Keine Kollision in der 2. Plane }
  161.            dummy := BltBitMap(MyBitMap,x1,y1,MyBitMap,x1,y1,xsize,ysize,$c0,4,BlittiSpeicher);
  162.            WaitBlit(); { Auf den Blitter warten, falls dieser noch arbeitet }
  163. {$A
  164.     btst.b  #5,$dff002          ; Diese Bit wollen wir testen
  165.     beq.s   Collision5          ; Kollision
  166.     move.w  #0,_blitctrl        ; keine Kollision
  167.     bra.s   Collision6          ; Keine weitere BitPlane
  168. Collision5:
  169.     move.w  #1,_blitctrl        ; Kollision
  170. Collision6:
  171.                                 ; Es gab keine Kollision
  172. }
  173.         end; { Abfrage 3. Plane }
  174.     end; { Abfrage 2. Plane }
  175.     Permit();   { Andere wollen auch mal arbeiten ! }
  176. end;{GraphCollision}
  177.  
  178. { --------------------------------------------------------------------- }
  179. { ---------    CollObjekt      ---------------------------------------- }
  180. { --------------------------------------------------------------------- }
  181.  
  182. Function CollObjekt(von, bis, x1, y1, sizex, sizey : short) : short;
  183. { Die Funktion ermittelt, welches Objekt in dem Rechteck x1, y1, x1+
  184.   sizex und y1+sizey Kollidiert ist. Hierbei kann ein von / bis Bereich
  185.   für die Objektuntersuchung angegeben werden (0 - 255 ).
  186.   Wird als Von-Wert -1 angegeben, so werden alle Objekte untersucht und
  187.   die erste Objektnummer, die zur Kollision führte, zurück gegeben.
  188.   Ist der Rückgabewert -1, so gab es eine Kolision mit einem nicht
  189.   definierten Objekt bzw. das Objekt wurde nicht gefunden.
  190. }
  191.  
  192. begin
  193.  
  194. {$A
  195.     movem.l d1-d7/a0-a3,-(sp)   ; alle benutzten Register sichern
  196.                             ; Wahnsinn, 11 Stück !!!
  197.                             ; Die Parameter liegen deshalb auch
  198.                             ; an der um +44 Korrigierten SP-Adresse
  199.     lea     _Objekt,a0      ; 1. Adresse der Elemente laden
  200.     move.l  _Objektsize,a1  ; Größe der Objekte laden
  201.  
  202.  
  203.     move.w  56(sp),d1       ; bis (Urspünglich: 12(sp))
  204.  
  205.     move.w  58(sp),d2       ; von (Urspünglich: 14(sp))
  206.  
  207.     cmp.w   d2,d1           ; Sind beide richtig angegeben?
  208.     bge.s   CollObjekt0     ; alles i.O.
  209.     exg.l   d2,d1           ; Nicht alles O.k., also tauschen.
  210. CollObjekt0:
  211.     tst.w   d2              ; erstmal die Flags setzen
  212.     beq.s   CollObjekt2A    ; Sonderfall !!! Objekt ist 0
  213.     bmi.s   CollObjekt2     ; Dann müssen alle Objekte bearbeitet werden
  214.     cmp.w   d2,d1           ; Ist der von/bis-Bereich gleich ?
  215.     beq.s   CollObjekt1B    ; Sonderfall !!! müßen wir gesondert bearbeiten
  216.     sub.w   d2,d1           ; Anzahl der Objekte - 1 (für dbra)
  217.  
  218. CollObjekt1:
  219.     movea.w d2,a3           ; sichern für den Rückgabezähler
  220.     move.l  a1,d4           ; Wert erstmal rüberschieben
  221.     mulu    d2,d4           ; und multiplizieren, Wert ist in d4
  222.     adda.l  d4,a0           ; Basisadresse in a0
  223.     bra.s   CollObjekt3     ; Steht jetzt in a0
  224.  
  225. CollObjekt1B:               ; Jetzt gehts ans Multiplizieren.
  226.     move.w  #0,d1           ; 1 Objekt ist zu bearbeiten
  227.     movea.w d2,a3           ; Die zu bearbeitende Objektnummer
  228.     move.l  a1,d4           ; Wert erstmal rüberschieben
  229.     mulu    d2,d4           ; und multiplizieren, Wert ist in d4
  230.     adda.l  d4,a0           ; und zu Basisadresse hinzuaddieren
  231.     bra.s   CollObjekt3     ; Steht jetzt in a0
  232.  
  233. CollObjekt2:
  234.     move.w  #255,d1         ; 256 Objekte sind zu bearbeiten
  235.     move.w  #0,a3           ; 1. zu bearbeitende Objektnummer
  236.     bra.s   CollObjekt3     ; weiter gehts
  237.  
  238. CollObjekt2A:
  239.     move.w  #0,d1           ; 1 Objekt ist zu bearbeiten
  240.     move.w  #0,a3           ; 1. zu bearbeitende Objektnummer
  241.  
  242. CollObjekt3:
  243.                             ; a0 = Startadresse des 1. Objektes
  244.                             ; a1 = Größe des Objektes
  245.                             ; a3 = Nummer des ersten Objektes
  246.                             ; d1 = Anzahl der Objekte -1
  247.  
  248.     move.w  48(sp),d4       ; sizey (Urspünglich: 4(sp))
  249.  
  250.     move.w  50(sp),d5       ; sizex (Urspünglich: 6(sp))
  251.  
  252.     move.w  52(sp),d6       ; y1 (Urspünglich: 8(sp))
  253.  
  254.     move.w  54(sp),d7       ; x1 (Urspünglich: 10(sp))
  255.  
  256.     add.w   d6,d4           ; addiert sizey + y1 um den unteren Eckpunkt
  257.                             ; zu bekommen.
  258.  
  259.     add.w   d7,d5           ; addiert sizex + x1 um den unteren Eckpunkt
  260.                             ; zu bekommen.
  261.  
  262. CollObjektLoop:
  263.                             ; Ab hier beginnt die Fragerei immer wieder
  264.     move.w  (a0),d2         ; Ox1-Position in D2
  265.     bmi     CollObjektNext  ; zur Beschleunigung der Abfrage, da Objekt
  266.                             ; tot ist.
  267.     move.w  2(a0),d3        ; Oy1-Position in D3
  268.  
  269.  
  270.     cmp.w   d7,d2           ; Ox1 >= Tx1
  271.     bge.s   CollObjekt4     ; Ja
  272.     bra.s   CollObjekt10    ; nein
  273. CollObjekt4:
  274.     cmp.w   d5,d2           ; Ox1 <= Tx2
  275.     bls.s   CollObjekt100   ; Ja
  276.                             ; nein, weiter bei Stufe 10
  277. CollObjekt10:
  278.     add.w   4(a0),d2        ; Ox1 um den x-size Wert erhöhen, um Ox2 zu bekommen
  279.     cmp.w   d7,d2           ; Ox2 >= Tx1
  280.     bge.s   CollObjekt11    ; Ja
  281.     bra.s   CollObjekt20    ; nein
  282.  
  283. CollObjekt11:
  284.     cmp.w   d5,d2           ; Ox2 <= Tx2
  285.     bls.s   CollObjekt100   ; Ja
  286.                             ; nein, weiter bei Stufe 20
  287. CollObjekt20:
  288.     move.w  (a0),d2         ; Ox1 wieder auf den alten Wert bringen
  289.     cmp.w   d2,d7           ; Tx1 >= Ox1
  290.     bge.s   CollObjekt21    ; Ja
  291.     bra.s   CollObjekt30    ; nein
  292.  
  293. CollObjekt21:
  294.     add.w   4(a0),d2        ; Ox1 um den x-size Wert erhöhen, um Ox2 zu bekommen
  295.     cmp.w   d2,d7           ; Tx1 <= Ox2
  296.     bls.s   CollObjekt100   ; Ja
  297.                             ; nein, weiter bei Stufe 30
  298. CollObjekt30:
  299.     move.w  (a0),d2         ; Ox1 wieder auf den alten Wert bringen
  300.     cmp.w   d2,d5           ; Tx2 >= Ox1
  301.     bge.s   CollObjekt31    ; Ja
  302.     bra.s   CollObjektNext  ; nein, also kein Treffer
  303.  
  304. CollObjekt31:
  305.     add.w   4(a0),d2        ; Ox1 um den x-size Wert erhöhen, um Ox2 zu bekommen
  306.     cmp.w   d2,d5           ; Tx1 <= Ox2
  307.     bls.s   CollObjekt100   ; Ja
  308.     bra.s   CollObjektNext  ; nein, also kein Treffer
  309.  
  310. CollObjekt100:
  311.     cmp.w   d6,d3           ; Oy1 >= Ty1
  312.     bge.s   CollObjekt101   ; Ja
  313.     bra.s   CollObjekt110   ; nein
  314. CollObjekt101:
  315.     cmp.w   d4,d3           ; Oy1 <= Ty2
  316.     bls.s   CollObjekt200   ; Ja
  317.                             ; nein, weiter bei Stufe 110
  318. CollObjekt110:
  319.     add.w   6(a0),d3        ; Oy1 um den y-size Wert erhöhen, um Oy2 zu bekommen
  320.     cmp.w   d6,d3           ; Oy2 >= Ty1
  321.     bge.s   CollObjekt111   ; Ja
  322.     bra.s   CollObjekt120   ; nein
  323.  
  324. CollObjekt111:
  325.     cmp.w   d4,d3           ; Oy2 <= Ty2
  326.     bls.s   CollObjekt200   ; Ja
  327.                             ; nein, weiter bei Stufe 120
  328. CollObjekt120:
  329.     move.w  2(a0),d3        ; Oy1 wieder auf den alten Wert bringen
  330.     cmp.w   d3,d6           ; Ty1 >= Oy1
  331.     bge.s   CollObjekt121   ; Ja
  332.     bra.s   CollObjekt130   ; nein
  333.  
  334. CollObjekt121:
  335.     add.w   6(a0),d3        ; Oy1 um den y-size Wert erhöhen, um Oy2 zu bekommen
  336.     cmp.w   d3,d6           ; Ty1 <= Oy2
  337.     bls.s   CollObjekt200   ; Ja
  338.                             ; nein, weiter bei Stufe 130
  339. CollObjekt130:
  340.     move.w  2(a0),d3        ; Oy1 wieder auf den alten Wert bringen
  341.     cmp.w   d3,d4           ; Ty2 >= Oy1
  342.     bge.s   CollObjekt131   ; Ja
  343.     bra.s   CollObjektNext  ; nein, also kein Treffer
  344.  
  345. CollObjekt131:
  346.     add.w   6(a0),d3        ; Oy1 um den y-size Wert erhöhen, um Oy2 zu bekommen
  347.     cmp.w   d3,d4           ; Tx1 <= Ox2
  348.     bls.s   CollObjekt200   ; Ja
  349.     bra.s   CollObjektNext  ; nein, also kein Treffer
  350.  
  351. CollObjekt200:
  352.                             ; Alle Bedingungen sind erfüllt worden,
  353.                             ; also ein Treffer
  354.     move.w  a3,d0           ; die getroffene Objektnummer in d0
  355.     bra.s   CollObjektEnd   ; und ab dafür
  356.  
  357. CollObjektNext:
  358.                             ; Eine oder mehrere Bedingungen wurden nicht
  359.                             ; erfüllt. Also das nächste Objekt.
  360.     adda.l  a1,a0           ; Nächste Objektadresse
  361.     adda.w  #1,a3           ; Objektnummer um eins erhöhen
  362.     dbra.s  d1,CollObjektLoop   ; und weiter geht's
  363.  
  364.     moveq   #-1,d0          ; wir haben kein passendes Objekt gefunden,
  365.                             ; also Fehler
  366.  
  367. CollObjektEnd:
  368.  
  369.     movem.l (sp)+,d1-d7/a0-a3   ; alle benutzten Register wieder zurück
  370. }
  371. end;
  372.  
  373. Procedure UnDrawObjekt( VonNr, BisNr : short );
  374. {   Löscht die mit VonNr bis BisNr gekennzeichnete Objekte. }
  375. var
  376.     tt1, tt2 : short;
  377. begin
  378.  
  379.     repeat
  380.         if Objekt[VonNr].Ox <> -1 then begin
  381.            { * Zuerst wollen wir mal den zweiten Eckpunkt ermitteln. * }
  382.            tt1 := Objekt[VonNr].Ox + Objekt[VonNr].Sizex;
  383.            tt2 := Objekt[VonNr].Oy + Objekt[VonNr].Sizey;
  384.  
  385.            { * Und ...Wusch... is es wech. * }
  386.            SetAPen(MyRPort,0);
  387.            SetBPen(MyRPort,0);
  388.            RectFill(MyRPort, Objekt[VonNr].Ox, Objekt[VonNr].Oy, tt1, tt2);
  389.         end;
  390.         { * Zähler erniedrigen. * }
  391.         INC(VonNr);
  392.     until VonNr > BisNr;
  393. end; { UnDrawObjekt }
  394.  
  395. { --------------------------------------------------------------------- }
  396. { ---------    GetChar                     ---------------------------- }
  397. { --------------------------------------------------------------------- }
  398.  
  399. Function GetChar() : byte;
  400. { Liefert den RAW-Wert einer Taste zurück.
  401.   Ein paar Tastencodes:     AMIGA-links   : $33
  402.                             AMIGA-rechts  : $31
  403.                             DEL           : $73
  404.                             Cursor hoch   : 103
  405.                             Cursor runter : 101
  406.                             Cursor rechts :  99
  407.                             Cursor links  :  97
  408. }
  409. begin
  410. {$A
  411.     move.b  $bfec01,d0  ; Tastaturcode in D0
  412. }
  413. end; {GetChar}
  414.  
  415. { --------------------------------------------------------------------- }
  416. { ---------    GetJoy2                     ---------------------------- }
  417. { --------------------------------------------------------------------- }
  418.  
  419. Function GetJoy2(): byte;
  420. { Gibt folgende Werte zurück:
  421.     0 - Joystick wurde nicht berührt
  422.     1 - Joystick nach rechts
  423.     2 - Joystick nach links
  424.     4 - Joystick nach hinten
  425.     8 - Joystick nach vorne
  426.    16 - Feuertaste gedrückt
  427. }
  428. begin
  429. {$A
  430.     movem.l d1-d2,-(sp)     ; Register sichern
  431.     moveq   #0,d0           ; sauber machen
  432.     moveq   #0,d1           ; sauber machen
  433.     move.w  $DFF00C,d1      ; JOY1DAT holen
  434.     btst.l  #1,d1           ; rechts ?
  435.     beq.s   GetJoy201       ; nein
  436.     bset.l  #0,d0           ; D0 setzen
  437. GetJoy201:
  438.     btst.l  #9,d1           ; links ?
  439.     beq.s   GetJoy202       ; nein
  440.     bset.l  #1,d0           ; D0 setzen
  441. GetJoy202:
  442.     move.w  d1,d2
  443.     lsr.w   #1,d2
  444.     eor.w   d1,d2
  445.     btst    #0,d2           ; hinten ?
  446.     beq.s   GetJoy203       ; nein
  447.     bset.l  #2,d0           ; D0 setzen
  448. GetJoy203:
  449.     btst    #8,d2           ; vorne ?
  450.     beq.s   GetJoy204       ; nein
  451.     bset.l  #3,d0           ; D0 setzen
  452. GetJoy204:
  453.     move.b  $BFE001,d1      ; CIA-A, Paralellport a
  454.     btst.l  #7,d1           ; Feuer ?
  455.     bne.s   GetJoy205       ; nein
  456.     bset.l  #4,d0           ; D0 setzen
  457. GetJoy205:
  458.     movem.l (sp)+,d1-d2     ; Register zurück
  459.  
  460. }
  461. end; { GetJoy2 }
  462.  
  463.  
  464. { --------------------------------------------------------------------- }
  465. { --------- ChipCopy                       ---------------------------- }
  466. { --------------------------------------------------------------------- }
  467.  
  468. Function ChipCopy( Source : Address; Size : integer) : Address;
  469. { Allokiert ChipMem in der Größe Size und kopiert die Daten von
  470.   der Addresse Source dort hinein. Zurückgegeben wird die ChipMem
  471.   Adresse.
  472. }
  473.  
  474. begin
  475. {$A
  476.         XREF    _GfxBase
  477.         XREF    _LVOAllocRaster
  478.  
  479.         movem.l d1-d7/a0-a6,-(sp)   ; register sichern
  480.  
  481.         moveq   #8,d0           ; 1 Byte mal
  482.         move.l  60(sp),d1       ; Size; ursprünglich: 4(sp)
  483.         move.l  _GfxBase,a6
  484.         jsr     _LVOAllocRaster(a6) ; anfordern
  485.                                     ; d0 enthält jetzt die Adresse
  486.  
  487.         tst.l   d0              ; d0 testen
  488.         bne.s   ChipCopy1       ; ist nicht Null, also alles O.K.
  489.         moveq   #-1,d0          ; Returncode ist negativ
  490.         movem.l (sp)+,d1-d7/a0-a6   ; Register wieder zurück
  491.         rts                     ; und vorzeitiger Abbruch
  492.  
  493. ChipCopy1:
  494.         move.l  60(sp),d1       ; Size, ursprünglich: 4(sp), in d1
  495.         subq    #1,d1           ; um eins korrigieren
  496.         move.l  64(sp),a0       ; Source, ursprünglich: 8(sp), in a0
  497.         move.l  d0,a1           ; Destination in a1
  498.  
  499. Chipcopyloop:
  500.         move.b  (a0)+,(a1)+     ; kopieren und um eins erhöhen
  501.         dbra.s  d1,Chipcopyloop ; wenn noch nicht zuende, dann weitermachen
  502.  
  503.         movem.l (sp)+,d1-d7/a0-a6   ; Register wieder zurück
  504.                                     ; D0 enthält jetzt die ChipMemAdresse
  505. }
  506.  
  507. end;{ ChipCopy }
  508.  
  509. { --------------------------------------------------------------------- }
  510. { --------- IntToStr6                      ---------------------------- }
  511. { --------------------------------------------------------------------- }
  512.  
  513. Procedure IntToStr6(s : string; i : integer);
  514. { Konvertiert positive Zahlen in das Stringformat mit führenden
  515.     Nullen. Max. 6 Nullen und max. die Zahl 999999 }
  516. begin
  517. {$A
  518.         movem.l d1-d2/a0,-(sp)  ; register retten
  519.  
  520.         move.l  16(sp),d0       ; d0 enthält i
  521.         move.l  20(sp),a0       ; a0 enthält den stringpointer s
  522.                                 ; jetzt komt die Abzugstabelle
  523.         move.l  #100000,d2
  524.         bsr.s   1$
  525.         move.l  #10000,d2
  526.         bsr.s   1$
  527.         move.l  #1000,d2
  528.         bsr.s   1$
  529.         move.l  #100,d2
  530.         bsr.s   1$
  531.         move.l  #10,d2
  532.         bsr.s   1$
  533.         move.l  #1,d2
  534.         bsr.s   1$
  535.         move.b  #0,(a0)         ; noch das Ende kennzeichnen
  536.         movem.l (sp)+,d1-d2/a0  ; Register wieder zurückholen
  537.         rts
  538. 1$
  539.         moveq   #'0',d1         ; d1 mit 0 vorbelegen
  540. 2$
  541.         sub.l   d2,d0           ; d2 von d0 abziehen
  542.         bmi.s   4$              ; Minus? dann nach 4$
  543.         addq    #1,d1           ; d1 ums eins erhöhen und
  544.         bra.s   2$              ; nach 2$ zurück
  545. 3$
  546.         move.b  d1,(a0)+        ; Zahl ablegen
  547.         rts
  548. 4$
  549.         add.l   d2,d0           ; d0 wieder korrigieren
  550.         bra.s   3$              ; und zurück nach 3$
  551. }
  552. end; {IntToStr6}
  553.  
  554. Procedure PowerLEDOn();
  555. { Macht die PowerLED an }
  556. begin
  557. {$A
  558.     andi.b  #253,$bfe001
  559. }
  560. end;
  561.  
  562. Procedure PowerLEDOff();
  563. { Macht die PowerLED aus }
  564. begin
  565. {$A
  566.     ori.b  #2,$bfe001
  567. }
  568. end;
  569.  
  570. { --------------------------------------------------------------------- }
  571. { ---------   DrawObjekt                   ---------------------------- }
  572. { --------------------------------------------------------------------- }
  573.  
  574. Procedure DrawObjekt( VonNr, BisNr : short );
  575. {   Zeichnet die mit VonNr bis BisNr gekennzeichnete Objekte. }
  576.  
  577. begin
  578.     Forbid();   { * Multitasking aus * }
  579. {$A
  580.  
  581.     movem.l d0-d7/a0-a6,-(sp)   ; alle benutzten Register sichern
  582.                                 ; Als erstes löschen wir den BlittiSpeicher
  583.  
  584.                             ; Und jetzt suchen wir die Objektadresse
  585.     lea.l   _Objekt,a0      ; 1. Adresse der Elemente laden
  586.     move.l  _Objektsize,a1  ; Größe der Objekte laden
  587.     lea.l   _Picture,a2     ; Startadresse Picturedaten
  588.  
  589.     move.w  64(sp),d1       ; bis (Urspünglich: 4(sp))
  590.  
  591.     move.w  66(sp),d2       ; von (Urspünglich: 6(sp))
  592.  
  593.     cmp.w   d2,d1           ; Sind beide richtig angegeben?
  594.     bge.s   DrawObjekt1     ; alles i.O.
  595.     exg.l   d2,d1           ; Nicht alles O.k., also tauschen.
  596.  
  597. DrawObjekt1:                ; Jetzt die Adresse ermitteln
  598.     move.l  a1,d3           ; Größe erstmal rüberschieben
  599.     mulu.w  d2,d3           ; und mit "von" multiplizieren, Wert in d3
  600.     adda.l  d3,a0           ; und mit der Basisadresse in a0 addieren
  601.                             ; jetzt haben wir die Startadresse
  602.  
  603. DrawObjekt2:                ; x und y-Werte holen und umrechnen
  604.     moveq   #0,d3           ; erstmal sauber machen
  605.     moveq   #0,d4           ; erstmal sauber machen
  606.     move.w  (a0),d3         ; x-Position in d3
  607.     bmi     DrawObjektNext  ; Objekt tot? Dann das nächste
  608.     move.w  2(a0),d4        ; y-Position in d4
  609.  
  610.                             ; ******************************************
  611. DrawObjekt30:               ; zuerst müssen wir die Bilderdaten anpassen,
  612.                             ; da durch das verschieben der Bilderdaten
  613.                             ; unerwünschte Effekte auftreten können.
  614.                             ; ******************************************
  615.  
  616.     lea     _BlittiSpeicher,a3
  617.     move.l  (a3),a4         ; Adresse holen
  618.  
  619. DrawObjekt31:               ; Wir warten auf den Blitter
  620.     btst    #6,$dff002      ; wie siehts aus?
  621.     bne.s   DrawObjekt31    ; is noch nich fertich
  622.     move.w  #$0100,$dff040  ; BLTCON0 wird auf Null gesetzt + Ziel D
  623.     clr.w   $dff042         ; BLTCON1 auf 0
  624.     clr.w   $dff066         ; BLTDMOD auf 0 (kein Modulo)
  625.     move.l  #$ffffffff,$dff044 ; Keine Maskierung
  626.     move.l  a4,$dff054      ; Zieladresse nach BLTDP
  627.     move.w  #%0001100100001010,$dff058  ; Blitter startet (100 * 20)
  628.  
  629. DrawObjekt32:               ; Jetzt holen wir uns die entsprechenden
  630.                             ; Image-Daten
  631.     moveq   #0,d5           ; erstmal sauber machen
  632.     move.w  16(a0),d5       ; Typ-holen
  633.     subq    #1,d5           ; Und korigieren
  634.     lsl.w   #2,d5           ; Offset errechnen ( mal 4 )
  635.     move.l  d5,a5           ; sichern
  636.     adda.l   a2,a5          ; und mit Startadresse Picturedaten addieren
  637.     move.l  (a5),a3         ; Jetzt Adresse-Imagedaten holen
  638.     moveq   #0,d5           ; sauber machen
  639.     moveq   #0,d6           ; sauber machen
  640.     moveq   #0,d7           ; sauber machen
  641.     move.w  4(a0),d5        ; Breite holen  *CHANGE*
  642.     move.w  6(a0),d6        ; Höhe holen    *CHANGE*
  643.     move.w  8(a3),d7        ; BitPlanes holen
  644.  
  645.                             ; Jetzt müssen wir die Bilddaten erstmal
  646.                             ; modifizieren, da der Blitter durch das
  647.                             ; verschieben die Bilder falsch rausbringt.
  648.                             ; Deshalb muß jeder Bild-Plane ein Word an
  649.                             ; gehängt werden.
  650.  
  651. DrawObjekt34:                ; Jetzt wollen wir die Anzahl der zu
  652.                             ; kopierenden Bytes errechen
  653.     add.w   #15,d5          ; Plus 15
  654.     lsr.w   #4,d5           ; durch 16 teilen = Anzahl Words Breite
  655.     move.w  d6,d0           ; Höhe Zwischenspeichern
  656.     mulu.w  d7,d0           ; mal Anzahl der Bitplanes
  657.     lsl.w   #6,d0           ; verschieben
  658.     add.w   d5,d0           ; addiert mit der breite in Words =
  659.                             ; Blitterwert der zu kopierenden Bytes. Uff!!
  660.  
  661. DrawObjekt35:               ; Wir warten auf den Blitter
  662.     btst    #6,$dff002      ; wie siehts aus?
  663.     bne.s   DrawObjekt35    ; is noch nich fertich
  664.     move.l  10(a3),$dff050  ; Startadresse für A
  665.     move.l  a4,$dff054      ; Zieladresse für D
  666.     move.w  #2,$dff066      ; BLTDMOD = 2 wg. anhängen
  667.     clr.w   $dff064         ; BLTAMOD = 0
  668.     move.w  #%0000100111110000,$dff040   ; Minterms und A + D anschalten
  669.     clr.w   $dff042         ; BLTCON1 auf 0
  670.     move.w  d0,$dff058      ; Blitter startet. Unsere Bilderdaten stehen
  671.                             ; jetzt also im BlittiSpeicher
  672.                             ; Jetzt müssen wir noch die urspünglichen
  673.                             ; Daten korrigieren. d6 (höhe) und d7(Bit-
  674.                             ; planes) bleiben.
  675.                             ; Die neuen Bilddaten stehen jetzt in der
  676.                             ; Adresse Register a4
  677.     addq    #1,d5           ; Breite um ein Word erhöhen
  678.  
  679. DrawObjekt4:                ; Jetzt die Byteposition ausrechnen
  680.     mulu.w  #80,d4          ; y * 80 Byte für 640*200 Schirm
  681.     move.w  d3,d0           ; Wert sichern
  682.     lsr.w   #3,d3           ; durch 8 = Anzahl Words
  683.     add.w   d4,d3           ; Bytepostion auf Wordgrenze gerechnet
  684.     andi.w  #$000f,d0       ; Ausmaskieren
  685.  
  686.                             ; Wert für BLTCON0 vorbereiten
  687.  
  688.     ror.w   #4,d0           ; Smoothwert schieben
  689.     add.w   #%0000110111111100,d0   ; Minterms und A,B + D anschalten
  690.  
  691. DrawObjekt41:               ; Wir warten auf den Blitter
  692.     btst    #6,$dff002      ; wie siehts aus?
  693.     bne.s   DrawObjekt41    ; is noch nich fertich
  694.     move.w  d0,$dff040      ; in BLTCON0
  695.     clr.w   $dff042         ; BLTCON1 löschen
  696.  
  697. DrawObjekt5:                ; Jetzt wollen wir die Anzahl der zu
  698.                             ; kopierenden Bytes errechen
  699.     move.w  d6,d0           ; Höhe Zwischenspeichern
  700.     lsl.w   #6,d0           ; verschieben
  701.     add.w   d5,d0           ; addiert mit der breite in Words =
  702.                             ; Blitterwert der zu kopierenden Bytes. Uff!!
  703.  
  704. DrawObjekt51:               ; Jetzt die Modulowerte errechnen
  705.     lsl.w   #1,d5           ; auf Bytes bringen
  706.     moveq   #80,d4          ; Bytes Zielwert
  707.     sub.w   d5,d4           ; und Breite Bilder abziehen = Modulo-Wert
  708.     clr.w   $dff064         ; A hat keinen Modulo-Wert
  709.     move.w  d4,$dff066      ; Aber Ziel D
  710.     move.w  d4,$dff062      ; und Quelle B
  711.  
  712.                             ; Errechnen der Offset Bilddaten
  713.     mulu.w  d5,d6           ; Höhe in Bytes mal Breite in Bytes
  714.  
  715.  
  716.                             ; Die Register enthalten jetzt folgende
  717.                             ; Werte: - a0 : Startadresse Objektdaten
  718.                             ;        - a1 : Größe eines Objekteintrages
  719.                             ;        - a2 : Startadresse Picturedaten
  720.                             ;        - a4 : Startadresse Bilderdaten
  721.                             ;        - d0 : Anzahl der Blitter-Bytes
  722.                             ;        - d1 : BisNr.
  723.                             ;        - d2 : VonNr.
  724.                             ;        - d3 : Offset Bildschirmadresse
  725.                             ;        - d6 : Offset Bilderdaten
  726.                             ;        - d7 : Anzahl Bild-Bitplanes
  727.  
  728. DrawObjekt6:                ; BitPlanedaten festhalten
  729.     lea.l   _MyBitMap,a3    ; Basisadresse laden
  730.     move.l  (a3),a6         ; Jetzt die richtige Adresse holen
  731.     move.l  a6,a3           ; wieder zurück
  732.     move.l  8(a3),a5        ; Adresse erste BitPlane
  733.     adda.l  d3,a5           ; und mit Offset addieren
  734.     move.l  a5,$dff054      ; Adresse Ziel
  735.     move.l  a5,$dff04c      ; Adresse Quelle B
  736.     move.l  a4,$dff050      ; Adresse Quelle A
  737.     move.w  d0,$dff058      ; und Blitter starten
  738.  
  739. DrawObjekt7:                ; Wir warten auf den Blitter
  740.     btst    #6,$dff002      ; wie siehts aus?
  741.     bne.s   DrawObjekt7
  742.     subq    #1,d7           ; eine weniger
  743.     beq.s   DrawObjektNext  ; wenn keine mehr da ist, ab dafür
  744.     adda.l  d6,a4           ; Offset dazu
  745.     move.l  12(a3),a5       ; Adresse zweite BitPlane
  746.     adda.l  d3,a5           ; und mit Offset addieren
  747.     move.l  a5,$dff054      ; Adresse Ziel
  748.     move.l  a5,$dff04c      ; Adresse Quelle B
  749.     move.l  a4,$dff050      ; Adresse Quelle A
  750.     move.w  d0,$dff058      ; und Blitter starten
  751.  
  752. DrawObjekt8:                ; Wir warten auf den Blitter
  753.     btst    #6,$dff002      ; wie siehts aus?
  754.     bne.s   DrawObjekt8
  755.     subq    #1,d7           ; eine weniger
  756.     beq.s   DrawObjektNext  ; wenn keine mehr da ist, ab dafür
  757.     adda.l  d6,a4           ; Offset dazu
  758.     move.l  16(a3),a5       ; Adresse dritte BitPlane
  759.     adda.l  d3,a5           ; und mit Offset addieren
  760.     move.l  a5,$dff054      ; Adresse Ziel
  761.     move.l  a5,$dff04c      ; Adresse Quelle B
  762.     move.l  a4,$dff050      ; Adresse Quelle A
  763.     move.w  d0,$dff058      ; und Blitter starten
  764.                             ; das wars
  765. DrawObjektNext:
  766.     addq    #1,d2           ; von nummer um eins erhöhen
  767.     cmp.w   d2,d1           ; größer als bis nummer?
  768.     bmi.s   DrawObjektEnd   ; nö, also ende
  769.     add.l   a1,a0           ; neue Adresse
  770.     bra     DrawObjekt2     ; Also machen wirs nochmal
  771.  
  772. DrawObjektEnd:
  773.     movem.l (sp)+,d0-d7/a0-a6 ; alle benutzten Register zurück
  774. }
  775.     Permit();
  776. end; { DrawObjekt }
  777.  
  778. { --------------------------------------------------------------------- }
  779. { ---------   VB-Server                    ---------------------------- }
  780. { --------------------------------------------------------------------- }
  781.  
  782. { * Hier kommt der Assemblercode für den Zähler. * }
  783. Procedure Initvb0();
  784. begin
  785. {$A
  786. initvb0:
  787.         ADDI.L  #1,(A1)          ;* increments counter is_Data points to
  788.         MOVEQ.L #0,D0            ;* set Z flag to continue to process other vb-servers
  789.         RTS                      ;* return to exec
  790. }
  791. end; { * Initvb0 * }
  792.  
  793. Procedure InitVB();
  794. { * Initialisiert den VB-Server. * }
  795. begin
  796.     vbcounter := 0;
  797.     vbint := AllocMem(SIZEOF(Interrupt), MEMF_PUBLIC+MEMF_CLEAR);   { *  interrupt node. * }
  798.  
  799.     vbint^.is_node.ln_type := NTINTERRUPT;         { * Initialize the node. * }
  800.     vbint^.is_node.ln_succ := Nil;
  801.     vbint^.is_node.ln_pred := Nil;
  802.     vbint^.is_node.ln_pri  := -60;
  803.     vbint^.is_node.ln_name := "VB-Server";
  804.     vbint^.is_data := ADR(VBCounter);
  805.     vbint^.is_code := ADR(Initvb0);
  806.     AddIntServer(INTB_VERTB, vbint); { * Kick this interrupt server to life. * }
  807. end; { * InitVB * }
  808.  
  809. Procedure Exitvb();
  810. { * Gibt den VB-Server wieder frei. * }
  811.  
  812. BEGIN
  813.      RemIntServer(INTB_VERTB, vbint);
  814.      FreeMem(vbint, SIZEOF(Interrupt));
  815. end; { ExitVB }
  816.  
  817. Procedure Settime();
  818. { * Setzt den VB-Server-Wert uf 0. * }
  819.  
  820. BEGIN
  821.      vbcounter := 0;
  822. end; { ExitVb }
  823.  
  824. Function Gettime(): integer;
  825. { * Liefert den Wert des VBServer zurück. * }
  826. BEGIN
  827.     Gettime := vbcounter;
  828. end; { * Gettime * }
  829.  
  830. Procedure WaitVB(ticks : short);
  831. { * Wartet ticks Ticks vom VB. * }
  832. VAR
  833.  
  834.     tt  : integer;
  835.     tt1 : integer;
  836. BEGIN
  837.     If ticks = 0 Then Return;
  838.     tt1 := ticks + Gettime();
  839.     Repeat
  840.         tt := Gettime();
  841.     Until tt >= tt1;
  842. end; { * WaitVB. * }
  843.  
  844. { --------------------------------------------------------------------- }
  845. { ---------   Playsample                   ---------------------------- }
  846. { --------------------------------------------------------------------- }
  847. {
  848.         Playsample sind verschiedene Routinen für das Laden,
  849.         abspielen und wieder freigeben von 8-SVX-Sounds.
  850.  
  851.         Modifiziert und erstellt anhand des zum PCQ1.2b beigelegten
  852.         Beispieles 'Play8SVX'.
  853.  
  854.         Nähere Informatinen siehe Dokumentation.
  855. }
  856.  
  857.  
  858. Function D1Unpack(source : String; n : Integer; dest : String; x : Byte) : Byte;
  859. var
  860.     d : Byte;
  861.     i, lim : Integer;
  862. begin
  863.     lim := n shl 1;
  864.     for i := 0 to lim - 1 do begin
  865.         d := Ord(Source[i shr 1]);
  866.         if Odd(i) then
  867.             d := d and 15
  868.         else
  869.             d := d shr 4;
  870.         x := x + codeToDelta[d];
  871.         dest[i] := Chr(x);
  872.     end;
  873.     D1Unpack := x;
  874. end;
  875.  
  876. Procedure DUnpack(source : String; n : Integer; dest : Address);
  877. var
  878.     x : Byte;
  879. begin
  880.     x := D1Unpack(Adr(source[1]), n - 2, dest, Ord(source[0]));
  881. end;
  882.  
  883. Procedure FreeSample(Nummer: byte);
  884. { * Gibt das Sample mit der Nummer nummer aus der Sampletab wieder
  885.     frei inkl. aller belegter Speicherbereiche. * }
  886. begin
  887.     if Sampletab[nummer].dbuf <> Nil then
  888.         FreeMem(Sampletab[nummer].dbuf, Sampletab[nummer].dlen);
  889.     Sampletab[nummer].dbuf := Nil;
  890. end;
  891.  
  892. Procedure DoRead(Buffer : Address; Length : Integer);
  893. var
  894.     ReadResult : Integer;
  895. begin
  896.     ReadResult := DOSRead(FP, Buffer, Length);
  897.     If ReadResult <> Length then begin
  898.        Writeln("Abbruch DoRead.");
  899.        Exit(10);
  900.     end;
  901. end;
  902.  
  903. {***********************************************************************+}
  904.  
  905. Procedure PlaySample(nummer : short);
  906. { * Spielt den in der Sampletab abgelegten Sound ab. * }
  907. begin
  908. {$A
  909.     movem.l d0-d3/a0-a3,-(sp)   ; alle benutzten Register sichern.
  910.                             ; Die Parameter liegen deshalb auch
  911.                             ; an der um +32 Korrigierten SP-Adresse
  912.     moveq   #0,d0
  913.     moveq   #1,d3           ; für den DMA Wert
  914.  
  915.     move.w  36(sp),d0       ; nummer des Samples holen
  916.     subq.w  #1,d0           ; und korrigieren
  917.     lea     _Sampletab,a0   ; Adresse der Tabelle laden
  918.     move.l  _Sampletabsize,d1   ; Länge der Tabelle laden
  919.     mulu.w  d1,d0           ; und Multiplizieren
  920.     add.l   d0,a0           ; jetzt haben wir den Tabplatz
  921.  
  922.     lea     $dff0A0,a1      ; Beginn der Audio-Hardware holen
  923.     lea     $dff000,a2      ; Beginn der Hardware holen
  924.  
  925.     moveq   #0,d1
  926.     move.b  _Channel,d1     ; enthält den neu zu spielenden Kanal
  927.     cmp.b   #4,d1           ; Schon mehr als den 4. Kanal?
  928.     bne.s   Playsample1     ; Nein
  929.     moveq   #0,d1           ; Ja, also korrigieren
  930.  
  931. Playsample1:
  932.     lsl.w   d1,d3           ; DMA-Kanal ermitteln
  933.     moveq   #$10,d2
  934.     mulu.w  d1,d2           ; Wert errechnen
  935.     add.l   d2,a1           ; Beginn des entsprechenden Kanals
  936.     move.l  a1,d2           ; und sichern
  937.  
  938.     move.l  (a0)+,(a1)+     ; Samplebeginn übertragen
  939.     move.l  (a0)+,d0        ; Samplelänge  holen
  940.     lsr.l   #1,d0           ; und auf Word bringen
  941.     move.w  d0,(a1)+        ; Samplelänge  übertragen
  942.     move.w  (a0),(a1)+      ; Frequenz übertragen
  943.     move.w  #63,(a1)        ; Lautstärke auf max.
  944.  
  945.     move.w  d3,$96(a2)      ; DMA STOP
  946.     or.w    #$8000,d3       ; d3 auf DMA-an setzen
  947.     move.w  d3,$96(a2)      ; DMA Start
  948.  
  949.     addq.b  #1,d1           ; neuen Kanal errechnen.
  950.     move.b  d1,_Channel     ; und ablegen.
  951.     move.l  #1000,d1        ; Ein paar Buszyklen warten
  952. playsampleloop:
  953.     dbra.s  d1,playsampleloop
  954.  
  955.     move.l  d2,a1           ; aus der Sicherung zurückholen
  956.     moveq   #0,d2           ; und löschen
  957.     move.l  d2,(a1)+        ; Samplebeginn löschen
  958.     addq    #1,d2
  959.     move.w  d2,(a1)         ; Samplelänge löschen. Das wars.
  960.  
  961.     movem.l (sp)+,d0-d3/a0-a3   ; alle benutzten Register zurückholen.
  962.     rts
  963. }
  964. end;    { * Playsample * }
  965.  
  966.  
  967. {***********************************************************************+}
  968.  
  969. Function LoadSample(Nummer : byte; name : String): short;
  970. { Lädt ein IFF-8SVX Sample und weißt diesem alle erforderlichen Werte
  971.   zu.
  972.   Returncodes :  0 ---> Sample konnte O.K. initialisiert werden.
  973.                 -1 ---> File konnte nicht geöffnet werden.
  974.                 -2 ---> Kein Filename.
  975.                 -3 ---> Sampleplatz schon belegt.
  976.                 -4 ---> Kein IFF-8SVX-File.
  977.                 -7 ---> Kein Speicher für Sample.
  978.                 -9 ---> Kein Speicher für Dekompression.
  979.                -10 ---> Unbekannter Kompression-Type.
  980. }
  981. VAR
  982.     ckbuffer    : Array [0..2] of Short;
  983.     t           : Address;
  984.     oerr        : integer;
  985.     ckname      : String;
  986. Begin
  987.     If Sampletab[Nummer].dbuf <> Nil then LoadSample := -3;
  988.  
  989.     ckname := Adr(ckbuffer);
  990.     ckname[4] := '\0';
  991.  
  992.     if strlen(Name) = 0 then LoadSample := -2;
  993.     FP := DOSOpen(Name, MODE_OLDFILE);
  994.     if FP = Nil then LoadSample := -1;
  995.     DoRead(ckname, 4);
  996.     if streq(ckname, "FORM") then begin
  997.         DoRead(ckname,4);       { Get size out of the way. }
  998.         DoRead(ckname,4);
  999.         if streq(ckname,"8SVX") then begin
  1000.            DoRead(ckname,4);
  1001.            while not streq(ckname,"BODY") do begin
  1002.                  DoRead(Adr(Sampletab[nummer].dlen), 4);
  1003.                  if streq(ckname,"VHDR") then
  1004.                     DoRead(Adr(VHeader), SizeOf(Voice8Header));
  1005.                  DoRead(ckname,4);
  1006.            end;
  1007.            DoRead(Adr(Sampletab[nummer].dlen), 4);
  1008.         end else
  1009.             LoadSample := -4;
  1010.     end else
  1011.         LoadSample := -4;
  1012.  
  1013.     Sampletab[nummer].dbuf := AllocMem(Sampletab[nummer].dlen, MEMF_PUBLIC + MEMF_CHIP);
  1014.     if Sampletab[nummer].dbuf = Nil then LoadSample := -7;
  1015.  
  1016.     if Sampletab[nummer].dlen > 131000 then begin  { Supposed hardware limitation. }
  1017.         Sampletab[nummer].dlen := 131000;
  1018.     end else if Odd(Sampletab[nummer].dlen) then
  1019.         Sampletab[nummer].dlen := Pred(Sampletab[nummer].dlen);
  1020.     DoRead(Sampletab[nummer].dbuf, Sampletab[nummer].dlen);          { * Sample einlesen. * }
  1021.  
  1022.     if VHeader.sCompression = 1 then begin
  1023.         t := AllocMem(Sampletab[nummer].dlen shl 1, MEMF_CHIP + MEMF_PUBLIC);
  1024.         if t = Nil then LoadSample  := -9;
  1025.         DUnpack(Sampletab[nummer].dbuf, Sampletab[nummer].dlen, t);
  1026.         FreeMem(Sampletab[nummer].dbuf, Sampletab[nummer].dlen);
  1027.         Sampletab[nummer].dbuf := t;
  1028.         Sampletab[nummer].dlen := Sampletab[nummer].dlen shl 1;
  1029.     end else if VHeader.sCompression > 1 then LoadSample := -10;
  1030.  
  1031.     Sampletab[nummer].dhz := 3579546 div VHeader.samplesPerSec; { * Tonhöhe. * }
  1032.     DOSClose(FP);
  1033.     LoadSample := nummer;
  1034. end; { * LoadSample * }
  1035.